home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / file-io.cc < prev    next >
C/C++ Source or Header  |  1997-05-28  |  33KB  |  1,432 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. // Originally written by John C. Campbell <jcc@bevo.che.wisc.edu>
  24. //
  25. // Thomas Baier <baier@ci.tuwien.ac.at> added the original versions of
  26. // the following functions:
  27. //
  28. //   popen
  29. //   pclose
  30. //   execute       (now popen2.m)
  31. //   sync_system   (now merged with system)
  32. //   async_system  (now merged with system)
  33.  
  34. // Completely rewritten by John W. Eaton <jwe@bevo.che.wisc.edu>,
  35. // April 1996.
  36.  
  37. /* Modified by Klaus Gebhardt, 1997 */
  38.  
  39. #ifdef HAVE_CONFIG_H
  40. #include <config.h>
  41. #endif
  42.  
  43. #include <climits>
  44.  
  45. #include <iostream.h>
  46.  
  47. #ifdef HAVE_UNISTD_H
  48. #ifdef HAVE_SYS_TYPES_H
  49. #include <sys/types.h>
  50. #endif
  51. #include <unistd.h>
  52. #endif
  53.  
  54. #include "defun.h"
  55. #include "error.h"
  56. #include "file-ops.h"
  57. #include "help.h"
  58. #include "lo-ieee.h"
  59. #include "oct-fstrm.h"
  60. #include "oct-iostrm.h"
  61. #include "oct-map.h"
  62. #include "oct-obj.h"
  63. #include "oct-prcstrm.h"
  64. #include "oct-stream.h"
  65. #include "oct-strstrm.h"
  66. #include "pager.h"
  67. #include "sighandlers.h"
  68. #include "sysdep.h"
  69. #include "utils.h"
  70. #include "variables.h"
  71.  
  72. void
  73. initialize_file_io (void)
  74. {
  75.   octave_istream *stdin_stream
  76.     = new octave_istream (&cin, "stdin");
  77.  
  78.   // This uses octave_stdout (see pager.h), not cout so that Octave's
  79.   // standard output stream will pass through the pager.
  80.  
  81.   octave_ostream *stdout_stream
  82.     = new octave_ostream (&octave_stdout, "stdout");
  83.  
  84.   octave_ostream *stderr_stream
  85.     = new octave_ostream (&cerr, "stderr");
  86.  
  87.   octave_stream_list::insert (stdin_stream);
  88.   octave_stream_list::insert (stdout_stream);
  89.   octave_stream_list::insert (stderr_stream);
  90. }
  91.  
  92. void
  93. close_files (void)
  94. {
  95.   octave_stream_list::clear ();
  96. }
  97.  
  98. static void
  99. gripe_invalid_file_id (const char *fcn)
  100. {
  101.   ::error ("%s: invalid file id", fcn);
  102. }
  103.  
  104. static int
  105. fopen_mode_to_ios_mode (const string& mode)
  106. {
  107.   int retval = 0;
  108.  
  109.   if (! mode.empty ())
  110.     {
  111.       // Could probably be faster, but does it really matter?
  112.  
  113.       if (mode == "r")
  114.     retval = ios::in;
  115.       else if (mode == "w")
  116.     retval = ios::out | ios::trunc;
  117.       else if (mode == "a")
  118.     retval = ios::out | ios::app;
  119.       else if (mode == "r+")
  120.     retval = ios::in | ios::out;
  121.       else if (mode == "w+")
  122.     retval = ios::in | ios::out | ios::trunc;
  123.       else if (mode == "a+")
  124.     retval = ios::in | ios::out | ios::app;
  125.       else if (mode == "rb")
  126.     retval = ios::in | ios::bin;
  127.       else if (mode == "wb")
  128.     retval = ios::out | ios::trunc | ios::bin;
  129.       else if (mode == "ab")
  130.     retval = ios::out | ios::app | ios::bin;
  131.       else if (mode == "r+b")
  132.     retval = ios::in | ios::out | ios::bin;
  133.       else if (mode == "w+b")
  134.     retval = ios::in | ios::out | ios::trunc | ios::bin;
  135.       else if (mode == "a+b")
  136.     retval = ios::in | ios::out | ios::app | ios::bin;
  137.       else
  138.     ::error ("invalid mode specified");
  139.     }
  140.  
  141.   return retval;
  142. }
  143.  
  144. DEFUN (fclose, args, ,
  145.   "fclose (FILENUM): close a file")
  146. {
  147.   double retval = -1.0;
  148.  
  149.   int nargin = args.length ();
  150.  
  151.   if (nargin == 1)
  152.     {
  153.       retval = (double) octave_stream_list::remove (args(0));
  154.  
  155.       if (retval < 0)
  156.     gripe_invalid_file_id ("fclose");
  157.     }
  158.   else
  159.     print_usage ("fclose");
  160.  
  161.   return retval;
  162. }
  163.  
  164. DEFUN (fflush, args, ,
  165.   "fflush (FILENUM): flush buffered data to output file")
  166. {
  167.   double retval = -1.0;
  168.  
  169.   int nargin = args.length ();
  170.  
  171.   if (nargin == 1)
  172.     {
  173.       // XXX FIXME XXX -- any way to avoid special case for stdout?
  174.  
  175.       int fid = octave_stream_list::get_file_number (args (0));
  176.  
  177.       if (fid == 1)
  178.     {
  179.       flush_octave_stdout ();
  180.  
  181.       retval = 0.0;
  182.     }
  183.       else
  184.     {
  185.       octave_stream *os = octave_stream_list::lookup (fid);
  186.  
  187.       if (os)
  188.         retval = (double) os->flush ();
  189.       else
  190.         gripe_invalid_file_id ("fflush");
  191.     }
  192.     }
  193.   else
  194.     print_usage ("fflush");
  195.  
  196.   return retval;
  197. }
  198.  
  199. DEFUN (fgetl, args, ,
  200.   "[STRING, LENGTH] = fgetl (FILENUM [, LENGTH])\n\
  201. \n\
  202. read a string from a file")
  203. {
  204.   octave_value_list retval;
  205.  
  206.   retval(1) = 0.0;
  207.   retval(0) = -1.0;
  208.  
  209.   int nargin = args.length ();
  210.  
  211.   if (nargin == 1 || nargin == 2)
  212.     {
  213.       octave_stream *os = octave_stream_list::lookup (args(0));
  214.  
  215.       if (os)
  216.     {
  217.       octave_value len_arg = (nargin == 2)
  218.         ? args(1) : octave_value ((double) INT_MAX);
  219.  
  220.       bool err = false;
  221.  
  222.       string tmp = os->getl (len_arg, err);
  223.  
  224.       if (! err)
  225.         {
  226.           retval(1) = (double) tmp.length ();
  227.           retval(0) = tmp;
  228.         }
  229.     }
  230.       else
  231.     gripe_invalid_file_id ("fgetl");
  232.     }
  233.   else
  234.     print_usage ("fgetl");
  235.  
  236.   return retval;
  237. }
  238.  
  239. DEFUN (fgets, args, ,
  240.   "[STRING, LENGTH] = fgets (FILENUM [, LENGTH])\n\
  241. \n\
  242. read a string from a file")
  243. {
  244.   octave_value_list retval;
  245.  
  246.   retval(1) = 0.0;
  247.   retval(0) = -1.0;
  248.  
  249.   int nargin = args.length ();
  250.  
  251.   if (nargin == 1 || nargin == 2)
  252.     {
  253.       octave_stream *os = octave_stream_list::lookup (args(0));
  254.  
  255.       if (os)
  256.     {
  257.       octave_value len_arg = (nargin == 2)
  258.         ? args(1) : octave_value ((double) INT_MAX);
  259.  
  260.       bool err = false;
  261.  
  262.       string tmp = os->gets (len_arg, err);
  263.  
  264.       if (! err)
  265.          {
  266.           retval(1) = (double) tmp.length ();
  267.           retval(0) = tmp;
  268.         }
  269.     }
  270.       else
  271.     gripe_invalid_file_id ("fgets");
  272.     }
  273.   else
  274.     print_usage ("fgets");
  275.  
  276.   return retval;
  277. }
  278.  
  279. static octave_base_stream *
  280. do_stream_open (const string& name, const string& mode,
  281.         const string& arch, int& fid)
  282. {
  283.   octave_base_stream *retval = 0;
  284.  
  285.   fid = -1;
  286.  
  287.   int md = fopen_mode_to_ios_mode (mode);
  288.  
  289.   if (! error_state)
  290.     {
  291.       oct_mach_info::float_format flt_fmt =
  292.     oct_mach_info::string_to_float_format (arch);
  293.  
  294.       if (! error_state)
  295.     retval = new octave_fstream (name, md, flt_fmt);
  296.     }
  297.  
  298.   return retval;
  299. }
  300.  
  301. static octave_base_stream *
  302. do_stream_open (const octave_value& tc_name, const octave_value& tc_mode,
  303.         const octave_value& tc_arch, const char *fcn, int& fid)
  304. {
  305.   octave_base_stream *retval = 0;
  306.  
  307.   fid = -1;
  308.  
  309.   string name = tc_name.string_value ();
  310.  
  311.   if (! error_state)
  312.     {
  313.       string mode = tc_mode.string_value ();
  314.  
  315.       if (! error_state)
  316.     {
  317.       string arch = tc_arch.string_value ();
  318.  
  319.       if (! error_state)
  320.         retval = do_stream_open (name, mode, arch, fid);
  321.       else
  322.         ::error ("%s: architecture type must be a string", fcn);
  323.     }
  324.       else
  325.     ::error ("%s: file mode must be a string", fcn);
  326.     }
  327.   else
  328.     ::error ("%s: file name must be a string", fcn);
  329.  
  330.   return retval;
  331. }
  332.  
  333. DEFUN (fopen, args, ,
  334.   "[FILENUM, ERRMSG] = fopen (FILENAME, MODE [, ARCH]): open a file\n\
  335. \n\
  336.   FILENAME is a string specifying the name of the file.\n\
  337. \n\
  338.   MODE is a string specifying whether the file should be opened for\n\
  339.   reading, writing, or both.  Valid values for MODE include:\n\
  340. \n\
  341.     r  : open text file for reading\n\
  342.     w  : open text file for writing; discard previous contents if any\n\
  343.     a  : append; open or create text file for writing at end of file\n\
  344.     r+ : open text file for update (i.e., reading and writing)\n\
  345.     w+ : create text file for update; discard previous contents if any\n\
  346.     a+ : append; open or create text file for update, writing at end\n\
  347. \n\
  348.   Update mode permits reading from and writing to the same file.\n\
  349. \n\
  350.   ARCH is a string specifying the default data format for the file.\n\
  351.   Valid values for ARCH are:\n\
  352. \n\
  353.     native   --  the format of the current machine (this is the default)\n\
  354.     ieee-le  --  IEEE big endian\n\
  355.     ieee-be  --  IEEE little endian\n\
  356.     vaxd     --  VAX D floating format\n\
  357.     vaxg     --  VAX G floating format\n\
  358.     cray     --  Cray floating format\n\
  359. \n\
  360.   however, conversions are currently only supported for ieee-be, and\n\
  361.   ieee-le formats.\n\
  362. \n\
  363. \n\
  364.   FILENUM is a number that can be used to refer to the open file.\n\
  365.   If fopen fails, FILENUM is set to -1 and ERRMSG contains a\n\
  366.   system-dependent error message")
  367. {
  368.   octave_value_list retval;
  369.  
  370.   retval(0) = -1.0;
  371.  
  372.   int nargin = args.length ();
  373.  
  374.   if (nargin == 1)
  375.     {
  376.       if (args(0).is_string () && args(0).string_value () == "all")
  377.     retval(0) = octave_stream_list::open_file_numbers ();
  378.       else
  379.     {
  380.       string_vector tmp = octave_stream_list::get_info (args(0));
  381.  
  382.       if (! error_state)
  383.         {
  384.           retval(2) = tmp(2);
  385.           retval(1) = tmp(1);
  386.           retval(0) = tmp(0);
  387.         }
  388.     }
  389.  
  390.       return retval;
  391.     }
  392.  
  393.   if (nargin > 0 && nargin < 4)
  394.     {
  395.       octave_value mode = (nargin == 2 || nargin == 3)
  396.     ? args(1) : octave_value ("r");
  397.  
  398.       octave_value arch = (nargin == 3)
  399.     ? args(2) : octave_value ("native");
  400.  
  401.       int fid = -1;
  402.  
  403.       octave_base_stream *os
  404.     = do_stream_open (args(0), mode, arch, "fopen", fid);
  405.  
  406.       if (os)
  407.     {
  408.       if (os->ok () && ! error_state)
  409.         {
  410.           retval(1) = "";
  411.           retval(0) = (double) octave_stream_list::insert (os);
  412.         }
  413.       else
  414.         {
  415.           int errno = 0;
  416.           retval(1) = os->error (false, errno);
  417.           retval(0) = -1.0;
  418.         }
  419.     }
  420.       else
  421.     ::error ("fopen: internal error");
  422.     }
  423.   else
  424.     print_usage ("fopen");
  425.  
  426.   return retval;
  427. }
  428.  
  429. DEFUN (freport, args, ,
  430.   "freport (): list open files and their status")
  431. {
  432.   octave_value_list retval;
  433.  
  434.   int nargin = args.length ();
  435.  
  436.   if (nargin > 0)
  437.     warning ("freport: ignoring extra arguments");
  438.  
  439.   octave_stdout << octave_stream_list::list_open_files ();
  440.  
  441.   return retval;
  442. }
  443.  
  444. DEFUN (frewind, args, ,
  445.   "frewind (FILENUM): set file position at beginning of file")
  446. {
  447.   double retval = -1.0;
  448.  
  449.   int nargin = args.length ();
  450.  
  451.   if (nargin == 1)
  452.     {
  453.       octave_stream *os = octave_stream_list::lookup (args(0));
  454.  
  455.       if (os)
  456.     retval = (double) os->rewind ();
  457.       else
  458.     gripe_invalid_file_id ("frewind");
  459.     }
  460.   else
  461.     print_usage ("frewind");
  462.  
  463.   return retval;
  464. }
  465.  
  466. DEFUN (fseek, args, ,
  467.   "fseek (FILENUM, OFFSET [, ORIGIN])\n\
  468. \n\
  469. set file position for reading or writing.\n\
  470. \n\
  471. ORIGIN may be one of:\n\
  472. \n\
  473.   SEEK_SET : offset is relative to the beginning of the file (default)\n\
  474.   SEEK_CUR : offset is relative to the current position\n\
  475.   SEEK_END : offset is relative to the end of the file")
  476. {
  477.   double retval = -1.0;
  478.  
  479.   int nargin = args.length ();
  480.  
  481.   if (nargin == 2 || nargin == 3)
  482.     {
  483.       octave_stream *os = octave_stream_list::lookup (args(0));
  484.  
  485.       if (os)
  486.     {
  487.       octave_value origin_arg = (nargin == 3)
  488.         ? args(2) : octave_value (-1.0);
  489.  
  490.       retval = (double) os->seek (args(1), origin_arg);
  491.     }
  492.       else
  493.     ::error ("fseek: invalid file id");
  494.     }
  495.   else
  496.     print_usage ("fseek");
  497.  
  498.   return retval;
  499. }
  500.  
  501. DEFUN (ftell, args, ,
  502.   "POSITION = ftell (FILENUM): returns the current file position")
  503. {
  504.   double retval = -1.0;
  505.  
  506.   int nargin = args.length ();
  507.  
  508.   if (nargin == 1)
  509.     {
  510.       octave_stream *os = octave_stream_list::lookup (args(0));
  511.  
  512.       if (os)
  513.     retval = (double) os->tell ();
  514.       else
  515.     gripe_invalid_file_id ("ftell");
  516.     }
  517.   else
  518.     print_usage ("ftell");
  519.  
  520.   return retval;
  521. }
  522.  
  523. DEFUN (fprintf, args, ,
  524.   "fprintf (FILENUM, FORMAT, ...)")
  525. {
  526.   double retval = -1.0;
  527.  
  528.   int nargin = args.length ();
  529.  
  530.   if (nargin > 1 || (nargin > 0 && args(0).is_string ()))
  531.     {
  532.       octave_stream *os    = 0;
  533.       int fmt_n = 0;
  534.  
  535.       if (args(0).is_string ())
  536.     os = octave_stream_list::lookup (1);
  537.       else
  538.     {
  539.       fmt_n = 1;
  540.       os = octave_stream_list::lookup (args(0));
  541.     }
  542.   
  543.       if (os)
  544.     {
  545.       if (args(fmt_n).is_string ())
  546.         {
  547.           string fmt = args(fmt_n).string_value ();
  548.  
  549.           octave_value_list tmp_args;
  550.  
  551.           if (nargin > 1 + fmt_n)
  552.         {
  553.           tmp_args.resize (nargin-fmt_n-1, octave_value ());
  554.  
  555.           for (int i = fmt_n + 1; i < nargin; i++)
  556.             tmp_args(i-fmt_n-1) = args(i);
  557.         }
  558.  
  559.           retval = os->printf (fmt, tmp_args);
  560.         }
  561.       else
  562.         ::error ("fprintf: format must be a string");
  563.     }
  564.       else
  565.     gripe_invalid_file_id ("fprintf");
  566.     }
  567.   else
  568.     print_usage ("fprintf");
  569.  
  570.   return retval;
  571. }
  572.  
  573. DEFUN (fputs, args, ,
  574.   "fputs (FILENUM, STRING)")
  575. {
  576.   double retval = -1.0;
  577.  
  578.   int nargin = args.length ();
  579.  
  580.   if (nargin == 2)
  581.     {
  582.       octave_stream *os = octave_stream_list::lookup (args(0));
  583.  
  584.       if (os)
  585.     retval = os->puts (args(1));
  586.       else
  587.     gripe_invalid_file_id ("fputs");
  588.     }
  589.   else
  590.     print_usage ("fputs");
  591.  
  592.   return retval;
  593. }
  594.  
  595. DEFUN (sprintf, args, ,
  596.   "[s, errmsg, status] = sprintf (FORMAT, ...)")
  597. {
  598.   octave_value_list retval;
  599.  
  600.   int nargin = args.length ();
  601.  
  602.   if (nargin > 0)
  603.     {
  604.       retval(2) = -1.0;
  605.       retval(1) = "unknown error";
  606.       retval(0) = "";
  607.  
  608.       octave_ostrstream ostr;
  609.  
  610.       octave_stream os (&ostr, true);
  611.  
  612.       if (os)
  613.     {
  614.       if (args(0).is_string ())
  615.         {
  616.           string fmt = args(0).string_value ();
  617.  
  618.           octave_value_list tmp_args;
  619.  
  620.           if (nargin > 1)
  621.         {
  622.           tmp_args.resize (nargin-1, octave_value ());
  623.  
  624.           for (int i = 1; i < nargin; i++)
  625.             tmp_args(i-1) = args(i);
  626.         }
  627.  
  628.           retval(2) = os.printf (fmt, tmp_args);
  629.           retval(1) = os.error ();
  630.           char *tmp = ostr.str ();
  631.           retval(0) = tmp;
  632.           delete [] tmp;
  633.         }
  634.       else
  635.         ::error ("sprintf: format must be a string");
  636.     }
  637.       else
  638.     ::error ("sprintf: unable to create output buffer");
  639.     }
  640.   else
  641.     print_usage ("sprintf");
  642.  
  643.   return retval;
  644. }
  645.  
  646. DEFUN (fscanf, args, ,
  647.   "[A, COUNT] = fscanf (FILENUM, FORMAT [, SIZE])\n\
  648. \n\
  649. Read from FILENUM according to FORMAT, returning the result in the\n\
  650. matrix A.  SIZE is optional.  If present, it can be one of\n\
  651. \n\
  652.        Inf : read as much as possible, returning a column vector\n\
  653.              (unless doing all character conversions, in which case a\n\
  654.              string is returned)\n\
  655.         NR : read as much as possible, returning a matrix with NR rows\n\
  656.   [NR, NC] : read up to NR x NC elements, returning a matrix with NR rows\n\
  657.  [NR, Inf] : same as NR\n\
  658. \n\
  659. If it is omitted, a value of Inf is assumed.\n\
  660. \n\
  661. The number of items successfully read is returned in COUNT.\n\
  662. \n\
  663. [A, B, ...] = fscanf (FILENUM, FORMAT, \"C\")\n\
  664. \n\
  665. Read from FILENUM according to FORMAT, with each conversion specifier\n\
  666. in FORMAT corresponding to a single scalar return value.  This form is\n\
  667. more `C-like', and also compatible with previous versions of Octave")
  668. {
  669.   octave_value_list retval;
  670.  
  671.   int nargin = args.length ();
  672.  
  673.   if (nargin == 3 && args(2).is_string ())
  674.     {
  675.       octave_stream *os = octave_stream_list::lookup (args(0));
  676.  
  677.       if (os)
  678.     {
  679.       if (args(1).is_string ())
  680.         {
  681.           string fmt = args(1).string_value ();
  682.  
  683.           retval = os->oscanf (fmt);
  684.         }
  685.       else
  686.         ::error ("fscanf: format must be a string");
  687.     }
  688.       else
  689.     gripe_invalid_file_id ("fscanf");
  690.     }
  691.   else
  692.     {
  693.       retval (1) = 0.0;
  694.       retval (0) = Matrix ();
  695.  
  696.       if (nargin == 2 || nargin == 3)
  697.     {
  698.       octave_stream *os = octave_stream_list::lookup (args(0));
  699.  
  700.       if (os)
  701.         {
  702.           if (args(1).is_string ())
  703.         {
  704.           string fmt = args(1).string_value ();
  705.  
  706.           int count = 0;
  707.  
  708.           Matrix size = (nargin == 3)
  709.             ? args(2).matrix_value () : Matrix (1, 1, octave_Inf);
  710.  
  711.           if (! error_state)
  712.             {
  713.               octave_value tmp = os->scanf (fmt, size, count);
  714.  
  715.               retval(1) = (double) count;
  716.               retval(0) = tmp;
  717.             }
  718.         }
  719.           else
  720.         ::error ("fscanf: format must be a string");
  721.         }
  722.       else
  723.         gripe_invalid_file_id ("fscanf");
  724.     }
  725.       else
  726.     print_usage ("fscanf");
  727.     }
  728.  
  729.   return retval;
  730. }
  731.  
  732. DEFUN (sscanf, args, ,
  733.   "[A, COUNT, ERRMSG, INDEX] = sscanf (STRING, FORMAT, SIZE)\n\
  734. \n\
  735. Read from STRING according to FORMAT, returning the result in the\n\
  736. matrix A.  SIZE is optional.  If present, it can be one of\n\
  737. \n\
  738.        Inf : read as much as possible, returning a column vector\n\
  739.              (unless doing all character conversions, in which case a\n\
  740.              string is returned)\n\
  741.         NR : read as much as possible, returning a matrix with NR rows\n\
  742.   [NR, NC] : read up to NR x NC elements, returning a matrix with NR rows\n\
  743.  [NR, Inf] : same as NR\n\
  744. \n\
  745. If it is omitted, a value of Inf is assumed.\n\
  746. \n\
  747. The number of items successfully read is returned in COUNT.  If an\n\
  748. error occurs, ERRMSG contains the text of the corresponding error\n\
  749. message.  INDEX contains the index of the next character to be read\n\
  750. from STRING\n\
  751. \n\
  752. [A, B, ...] = sscanf (STRING, FORMAT, \"C\")\n\
  753. \n\
  754. Read from STRING according to FORMAT, with each conversion specifier\n\
  755. in FORMAT corresponding to a single scalar return value.  This form is\n\
  756. more `C-like', and also compatible with previous versions of Octave")
  757. {
  758.   octave_value_list retval;
  759.  
  760.   int nargin = args.length ();
  761.  
  762.   if (nargin == 3 && args(2).is_string ())
  763.     {
  764.       if (args(0).is_string ())
  765.     {
  766.       string data = args(0).string_value ();
  767.  
  768.       octave_istrstream istr (data);
  769.  
  770.       octave_stream os (&istr, true);
  771.  
  772.       if (os)
  773.         {
  774.           if (args(1).is_string ())
  775.         {
  776.           string fmt = args(1).string_value ();
  777.  
  778.           retval = os.oscanf (fmt);
  779.         }
  780.           else
  781.         ::error ("sscanf: format must be a string");
  782.         }
  783.       else
  784.         ::error ("sscanf: unable to create temporary input buffer");
  785.     }
  786.       else
  787.     ::error ("sscanf: first argument must be a string");
  788.     }
  789.   else
  790.     {
  791.       if (nargin == 2 || nargin == 3)
  792.     {
  793.       retval(3) = -1.0;
  794.       retval(2) = "unknown error";
  795.       retval(1) = 0.0;
  796.       retval(0) = Matrix ();
  797.  
  798.       if (args(0).is_string ())
  799.         {
  800.           string data = args(0).string_value ();
  801.  
  802.           octave_istrstream istr (data);
  803.  
  804.           octave_stream os (&istr, true);
  805.  
  806.           if (os)
  807.         {
  808.           if (args(1).is_string ())
  809.             {
  810.               string fmt = args(1).string_value ();
  811.  
  812.               int count = 0;
  813.  
  814.               Matrix size = (nargin == 3)
  815.             ? args(2).matrix_value () : Matrix (1, 1, octave_Inf);
  816.  
  817.               octave_value tmp = os.scanf (fmt, size, count);
  818.  
  819.               // XXX FIXME XXX -- is this the right thing to do?
  820.               // Extract error message first, because getting
  821.               // position will clear it.
  822.               string errmsg = os.error ();
  823.  
  824.               retval(3) = (double) (os.tell () + 1);
  825.               retval(2) = errmsg;
  826.               retval(1) = (double) count;
  827.               retval(0) = tmp;
  828.             }
  829.           else
  830.             ::error ("sscanf: format must be a string");
  831.         }
  832.           else
  833.         ::error ("sscanf: unable to create temporary input buffer");
  834.         }
  835.       else
  836.         ::error ("sscanf: first argument must be a string");
  837.     }
  838.       else
  839.     print_usage ("sscanf");
  840.     }
  841.  
  842.   return retval;
  843. }
  844.  
  845. DEFUN (scanf, args, nargout,
  846.   "scanf (FORMAT) is equivalent to fscanf (stdin, FORMAT)")
  847. {
  848.   int nargin = args.length ();
  849.  
  850.   octave_value_list tmp_args (nargin+1, octave_value ());
  851.  
  852.   tmp_args (0) = 0.0;
  853.   for (int i = 0; i < nargin; i++)
  854.     tmp_args (i+1) = args (i);
  855.  
  856.   return Ffscanf (tmp_args, nargout);
  857. }
  858.  
  859. static octave_value
  860. do_fread (octave_stream& os, const octave_value& size_arg,
  861.       const octave_value& prec_arg, const octave_value& skip_arg,
  862.       const octave_value& arch_arg, int& count)
  863. {
  864.   octave_value retval;
  865.  
  866.   count = -1;
  867.  
  868.   Matrix size = size_arg.matrix_value ();
  869.  
  870.   if (! error_state)
  871.     {
  872.       string prec = prec_arg.string_value ();
  873.  
  874.       if (! error_state)
  875.     {
  876.       oct_data_conv::data_type dt
  877.         = oct_data_conv::string_to_data_type (prec);
  878.  
  879.       if (! error_state)
  880.         {
  881.           double dskip = skip_arg.double_value ();
  882.  
  883.           if (! error_state)
  884.         {
  885.           if (D_NINT (dskip) == dskip)
  886.             {
  887.               int skip = NINT (dskip);
  888.  
  889.               string arch = arch_arg.string_value ();
  890.  
  891.               if (! error_state)
  892.             {
  893.               oct_mach_info::float_format flt_fmt
  894.                 = oct_mach_info::string_to_float_format (arch);
  895.  
  896.               if (! error_state)
  897.                 retval = os.read (size, dt, skip, flt_fmt, count);
  898.             }
  899.               else
  900.             ::error ("fread: architecture type must be a string");
  901.             }
  902.           else
  903.             ::error ("fread: skip must be an integer");
  904.         }
  905.           else
  906.         ::error ("fread: invalid skip specified");
  907.         }
  908.       else
  909.         ::error ("fread: invalid data type specified");
  910.     }
  911.       else
  912.     ::error ("fread: precision must be a string");
  913.     }
  914.   else
  915.     ::error ("fread: invalid size specified");
  916.  
  917.   return retval;
  918. }
  919.  
  920. DEFUN (fread, args, ,
  921.   "[DATA, COUNT] = fread (FILENUM [, SIZE] [, PRECISION] [, SKIP] [, ARCH])\n\
  922. \n\
  923. Reads data in binary form of type PRECISION from a file.\n\
  924. \n\
  925.   FILENUM   : file number from fopen\n\
  926. \n\
  927.   SIZE      : size specification for the data matrix\n\
  928. \n\
  929.   PRECISION : string specifying type of data to read, valid types are\n\
  930. \n\
  931.    char, char*1, integer*1, int8  --  character\n\
  932.    schar, signed char             --  signed character\n\
  933.    uchar, unsigned char           --  unsigned character (default)\n\
  934.    short                          --  short integer\n\
  935.    ushort, unsigned short         --  unsigned short integer\n\
  936.    int                            --  integer\n\
  937.    uint, unsigned int             --  unsigned integer\n\
  938.    long                           --  long integer\n\
  939.    ulong, unsigned long           --  unsigned long integer\n\
  940.    float, float32, real*4         --  single precision float\n\
  941.    double, float64, real*8        --  double precision float\n\
  942.    int16, integer*2               --  two byte integer\n\
  943.    int32, integer*4               --  four byte integer\n\
  944. \n\
  945.   SKIP      : number of bytes to skip before each element is read\n\
  946.               (default is 0)\n\
  947. \n\
  948.   ARCH      : string specifying the data format for the file.  Valid
  949.               values are\n\
  950. \n\
  951.     native   --  the format of the current machine (default)\n\
  952.     ieee-le  --  IEEE big endian\n\
  953.     ieee-be  --  IEEE little endian\n\
  954.     vaxd     --  VAX D floating format\n\
  955.     vaxg     --  VAX G floating format\n\
  956.     cray     --  Cray floating format\n\
  957. \n\
  958.               however, conversions are currently only supported for\n\
  959.               ieee-be, and ieee-le formats.\n\
  960. \n\
  961. \n\
  962.   DATA      : matrix in which the data is stored\n\
  963. \n\
  964.   COUNT     : number of elements read")
  965. {
  966.   octave_value_list retval;
  967.  
  968.   int nargin = args.length ();
  969.  
  970.   if (nargin > 0 && nargin < 6)
  971.     {
  972.       retval(1) = -1.0;
  973.       retval(0) = Matrix ();
  974.  
  975.       octave_stream *os = octave_stream_list::lookup (args(0));
  976.  
  977.       if (os)
  978.     {
  979.       octave_value size = (nargin > 1)
  980.         ? args(1) : octave_value (octave_Inf);
  981.  
  982.       octave_value prec = (nargin > 2)
  983.         ? args(2) : octave_value ("uchar");
  984.  
  985.       octave_value skip = (nargin > 3)
  986.         ? args(3) : octave_value (0.0);
  987.  
  988.       octave_value arch = (nargin > 4)
  989.         ? args(4) : octave_value ("unknown");
  990.  
  991.       int count = -1;
  992.  
  993.       octave_value tmp = do_fread (*os, size, prec, skip, arch, count);
  994.  
  995.       retval(1) = (double) count;
  996.       retval(0) = tmp;
  997.     }
  998.       else
  999.     gripe_invalid_file_id ("fread");
  1000.     }
  1001.   else
  1002.     print_usage ("fread");
  1003.  
  1004.   return retval;
  1005. }
  1006.  
  1007. static int
  1008. do_fwrite (octave_stream& os, const octave_value& data,
  1009.        const octave_value& prec_arg, const octave_value& skip_arg,
  1010.        const octave_value& arch_arg)
  1011. {
  1012.   int retval = -1;
  1013.  
  1014.   string prec = prec_arg.string_value ();
  1015.  
  1016.   if (! error_state)
  1017.     {
  1018.       oct_data_conv::data_type dt
  1019.     = oct_data_conv::string_to_data_type (prec);
  1020.  
  1021.       if (! error_state)
  1022.     {
  1023.       double dskip = skip_arg.double_value ();
  1024.  
  1025.       if (! error_state)
  1026.         {
  1027.           if (D_NINT (dskip) == dskip)
  1028.         {
  1029.           int skip = NINT (dskip);
  1030.  
  1031.           string arch = arch_arg.string_value ();
  1032.  
  1033.           if (! error_state)
  1034.             {
  1035.               oct_mach_info::float_format flt_fmt
  1036.             = oct_mach_info::string_to_float_format (arch);
  1037.  
  1038.               if (! error_state)
  1039.             retval = os.write (data, dt, skip, flt_fmt);
  1040.             }
  1041.           else
  1042.             ::error ("fwrite: architecture type must be a string");
  1043.         }
  1044.           else
  1045.         ::error ("fwrite: skip must be an integer");
  1046.         }
  1047.       else
  1048.         ::error ("fwrite: invalid skip specified");
  1049.     }
  1050.     }
  1051.   else
  1052.     ::error ("fwrite: precision must be a string");
  1053.  
  1054.   return retval;
  1055. }
  1056.  
  1057. DEFUN (fwrite, args, ,
  1058.   "COUNT = fwrite (FILENUM, DATA [, PRECISION] [, SKIP] [, ARCH])\n\
  1059. \n\
  1060.   Writes data to a file in binary form of size PRECISION\n\
  1061. \n\
  1062.   FILENUM   : file number from fopen\n\
  1063. \n\
  1064.   DATA      : matrix of elements to be written\n\
  1065. \n\
  1066.   PRECISION : string specifying type of data to read, valid types are\n\
  1067. \n\
  1068.    char, char*1, integer*1, int8  --  character\n\
  1069.    schar, signed char             --  signed character\n\
  1070.    uchar, unsigned char           --  unsigned character (default)\n\
  1071.    short                          --  short integer\n\
  1072.    ushort, unsigned short         --  unsigned short integer\n\
  1073.    int                            --  integer\n\
  1074.    uint, unsigned int             --  unsigned integer\n\
  1075.    long                           --  long integer\n\
  1076.    ulong, unsigned long           --  unsigned long integer\n\
  1077.    float, float32, real*4         --  single precision float\n\
  1078.    double, float64, real*8        --  double precision float\n\
  1079.    int16, integer*2               --  two byte integer\n\
  1080.    int32, integer*4               --  four byte integer\n\
  1081. \n\
  1082.   SKIP      : number of bytes to skip before each element is read\n\
  1083.               (the default is 0)\n\
  1084. \n\
  1085.   ARCH      : string specifying the data format for the file.  Valid
  1086.               values are\n\
  1087. \n\
  1088.     native   --  the format of the current machine (default)\n\
  1089.     ieee-le  --  IEEE big endian\n\
  1090.     ieee-be  --  IEEE little endian\n\
  1091.     vaxd     --  VAX D floating format\n\
  1092.     vaxg     --  VAX G floating format\n\
  1093.     cray     --  Cray floating format\n
  1094. \n\
  1095.   however, conversions are currently only supported for ieee-be, and\n\
  1096.   ieee-le formats.\n\
  1097. \n\
  1098. \n\
  1099.   COUNT     : number of elements written")
  1100. {
  1101.   octave_value retval = -1.0;
  1102.  
  1103.   int nargin = args.length ();
  1104.  
  1105.   if (nargin > 1 && nargin < 6)
  1106.     {
  1107.       octave_stream *os = octave_stream_list::lookup (args(0));
  1108.  
  1109.       if (os)
  1110.     {
  1111.       octave_value data = args(1);
  1112.  
  1113.       octave_value prec = (nargin > 2)
  1114.         ? args(2) : octave_value ("uchar");
  1115.  
  1116.       octave_value skip = (nargin > 3)
  1117.         ? args(3) : octave_value (0.0);
  1118.  
  1119.       octave_value arch = (nargin > 4)
  1120.         ? args(4) : octave_value ("unknown");
  1121.  
  1122.       retval = do_fwrite (*os, data, prec, skip, arch);
  1123.     }
  1124.       else
  1125.     gripe_invalid_file_id ("fwrite");
  1126.     }
  1127.   else
  1128.     print_usage ("fwrite");
  1129.  
  1130.   return retval;
  1131. }
  1132.  
  1133. DEFUN (feof, args, ,
  1134.   "ERROR = feof (FILENUM)\n\
  1135. \n\
  1136.  Returns a non zero value for an end of file condition for the\n\
  1137.  file specified by FILENUM from fopen")
  1138. {
  1139.   double retval = -1.0;
  1140.  
  1141.   int nargin = args.length ();
  1142.  
  1143.   if (nargin == 1)
  1144.     {
  1145.       octave_stream *os = octave_stream_list::lookup (args(0));
  1146.  
  1147.       if (os)
  1148.     retval = os->eof () ? 1.0 : 0.0;
  1149.       else
  1150.     gripe_invalid_file_id ("feof");
  1151.     }
  1152.   else
  1153.     print_usage ("feof");
  1154.  
  1155.   return retval;
  1156. }
  1157.  
  1158. DEFUN (ferror, args, ,
  1159.   "ERROR = ferror (FILENUM, [\"clear\"])\n\
  1160. \n\
  1161.  Returns a non zero value for an error condition on the\n\
  1162.  file specified by FILENUM from fopen")
  1163. {
  1164.   octave_value_list retval;
  1165.  
  1166.   int nargin = args.length ();
  1167.  
  1168.   if (nargin == 1 || nargin == 2)
  1169.     {
  1170.       octave_stream *os = octave_stream_list::lookup (args(0));
  1171.  
  1172.       if (os)
  1173.     {
  1174.       bool clear = false;
  1175.  
  1176.       if (nargin == 2)
  1177.         {
  1178.           string opt = args(1).string_value ();
  1179.  
  1180.           if (! error_state)
  1181.         clear = (opt == "clear");
  1182.           else
  1183.         return retval;
  1184.         }
  1185.  
  1186.       int error_number = 0;
  1187.  
  1188.       string error_message = os->error (clear, error_number);
  1189.  
  1190.       retval(1) = (double) error_number;
  1191.       retval(0) = error_message;
  1192.     }
  1193.       else
  1194.     gripe_invalid_file_id ("ferror");
  1195.     }
  1196.   else
  1197.     print_usage ("ferror");
  1198.  
  1199.   return retval;
  1200. }
  1201.  
  1202. DEFUN (popen, args, ,
  1203.   "FILENUM = popen (FILENAME, MODE)\n\
  1204. \n\
  1205.   start a process and create a pipe.  Valid values for mode are:\n\
  1206. \n\
  1207.   \"r\" : connect stdout of process to pipe\n\
  1208.   \"w\" : connect stdin of process to pipe")
  1209. {
  1210.   double retval = -1.0;
  1211.  
  1212.   int nargin = args.length ();
  1213.  
  1214.   if (nargin == 2)
  1215.     {
  1216.       string name = args(0).string_value ();
  1217.  
  1218.       if (! error_state)
  1219.     {
  1220.       string mode = args(1).string_value ();
  1221.  
  1222.       if (! error_state)
  1223.         {
  1224.           if (mode == "r")
  1225.         {
  1226.           octave_iprocstream *ips = new octave_iprocstream (name);
  1227.  
  1228.           retval = octave_stream_list::insert (ips);
  1229.         }
  1230.           else if (mode == "w")
  1231.         {
  1232.           octave_oprocstream *ops = new octave_oprocstream (name);
  1233.  
  1234.           retval = octave_stream_list::insert (ops);
  1235.         }
  1236.           else
  1237.         ::error ("popen: invalid mode specified");
  1238.         }
  1239.       else
  1240.         ::error ("popen: mode must be a string");
  1241.     }
  1242.       else
  1243.     ::error ("popen: name must be a string");
  1244.     }
  1245.   else
  1246.     print_usage ("popen");
  1247.  
  1248.   return retval;
  1249. }
  1250.  
  1251. DEFUN (pclose, args, ,
  1252.   "pclose (FILENUM)\n\
  1253. \n\
  1254.   Close a pipe and terminate the associated process")
  1255. {
  1256.   double retval = -1.0;
  1257.  
  1258.   int nargin = args.length ();
  1259.  
  1260.   if (nargin == 1)
  1261.     {
  1262.       retval = (double) octave_stream_list::remove (args(0));
  1263.  
  1264.       if (retval < 0)
  1265.     gripe_invalid_file_id ("pclose");
  1266.     }
  1267.   else
  1268.     print_usage ("pclose");
  1269.  
  1270.   return retval;
  1271. }
  1272.  
  1273. DEFUN (tmpnam, args, ,
  1274.  "tmpnam ()\n\
  1275. Return unique temporary file name.")
  1276. {
  1277.   octave_value retval;
  1278.  
  1279.   if (args.length () == 0)
  1280.     retval = oct_tempnam ();
  1281.   else
  1282.     print_usage ("tmpnam");
  1283.  
  1284.   return retval;
  1285. }
  1286.  
  1287. DEFALIAS (octave_tmp_file_name, tmpnam);
  1288.  
  1289. DEFUN (child_purge_temp, args, ,
  1290.  "child_purge_temp (pid, name)\n\
  1291. Remove the file NAME, when child PID dies.")
  1292. {
  1293.   octave_value retval = -1.0;
  1294.  
  1295.   if (args.length () == 2)
  1296.     {
  1297.       if (args(1).is_string ())
  1298.     {
  1299.       double d_pid = args(0).double_value ();
  1300.       string name  = args(1).string_value ();
  1301.  
  1302.       if (!error_state)
  1303.         {
  1304.           if (D_NINT (d_pid) == d_pid)
  1305.         {
  1306.           int i_pid = NINT (d_pid);
  1307.  
  1308.           octave_child_list::insert (i_pid, 0, name);
  1309.           retval = 0.0;
  1310.         }
  1311.           else
  1312.         error ("child_purge_temp: pid must be an integer");
  1313.         }
  1314.     }
  1315.       else
  1316.     error ("child_purge_temp: second argument must be a string");
  1317.     }
  1318.   else
  1319.     print_usage ("child_purge_temp");
  1320.  
  1321.   return retval;
  1322. }
  1323.  
  1324. static int
  1325. convert (int x, int ibase, int obase)
  1326. {
  1327.   int retval = 0;
  1328.  
  1329.   int tmp = x % obase;
  1330.  
  1331.   if (tmp > ibase - 1)
  1332.     ::error ("umask: invalid digit");
  1333.   else
  1334.     {
  1335.       retval = tmp;
  1336.       int mult = ibase;
  1337.       while ((x = (x - tmp) / obase))
  1338.     {
  1339.       tmp = x % obase;
  1340.       if (tmp > ibase - 1)
  1341.         {
  1342.           ::error ("umask: invalid digit");
  1343.           break;
  1344.         }
  1345.       retval += mult * tmp;
  1346.       mult *= ibase;
  1347.     }
  1348.     }
  1349.  
  1350.   return retval;
  1351. }
  1352.  
  1353. DEFUN (umask, args, ,
  1354.   "umask (MASK)\n\
  1355. \n\
  1356. Change the file permission mask for file creation for the current
  1357. process.  MASK is an integer, interpreted as an octal number.  If
  1358. successful, returns the previous value of the mask (as an integer to
  1359. be interpreted as an octal number); otherwise an error message is
  1360. printed.")
  1361. {
  1362.   octave_value_list retval;
  1363.  
  1364.   int status = 0;
  1365.  
  1366.   if (args.length () == 1)
  1367.     {
  1368.       double dmask = args(0).double_value ();
  1369.  
  1370.       if (error_state)
  1371.     {
  1372.       status = -1;
  1373.       ::error ("umask: expecting integer argument");
  1374.     }
  1375.       else
  1376.     {
  1377.       int mask = NINT (dmask);
  1378.  
  1379.       if ((double) mask != dmask || mask < 0)
  1380.         {
  1381.           status = -1;
  1382.           ::error ("umask: MASK must be a positive integer value");
  1383.         }
  1384.       else
  1385.         {
  1386.           int oct_mask = convert (mask, 8, 10);
  1387.  
  1388.           if (! error_state)
  1389.         status = convert (oct_umask (oct_mask), 10, 8);
  1390.         }
  1391.     }
  1392.     }
  1393.   else
  1394.     print_usage ("umask");
  1395.  
  1396.   if (status >= 0)
  1397.     retval(0) = (double) status;
  1398.  
  1399.   return retval;
  1400. }
  1401.  
  1402. void
  1403. symbols_of_file_io (void)
  1404. {
  1405.   // NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be
  1406.   // this way for Matlab compatibility.
  1407.  
  1408.   DEFCONST (SEEK_SET, -1.0, 0, 0,
  1409.     "used with fseek to position file relative to the beginning");
  1410.  
  1411.   DEFCONST (SEEK_CUR, 0.0, 0, 0,
  1412.     "used with fseek to position file relative to the current position");
  1413.  
  1414.   DEFCONST (SEEK_END, 1.0, 0, 0,
  1415.     "used with fseek to position file relative to the end");
  1416.  
  1417.   DEFCONSTX ("stdin", SBV_stdin, 0.0, 0, 0,
  1418.     "file number of the standard input stream");
  1419.  
  1420.   DEFCONSTX ("stdout", SBV_stdout, 1.0, 0, 0,
  1421.     "file number of the standard output stream");
  1422.  
  1423.   DEFCONSTX ("stderr", SBV_stderr, 2.0, 0, 0,
  1424.     "file number of the standard error stream");
  1425. }
  1426.  
  1427. /*
  1428. ;;; Local Variables: ***
  1429. ;;; mode: C++ ***
  1430. ;;; End: ***
  1431. */
  1432.